【例子介绍】Delphi简单DirectUI界面源码Unicode版
【相关图片】
【源码结构】
unit CometSkin;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ShellApi, AxCtrls, ActiveX, GDIPUTIL, GDIPAPI, GDIPOBJ;
const
SCM_NULL = 0;
SCM_MINIMIZE = -1; {标题栏_最小化按钮}
SCM_MAXIMIZE = -2; {标题栏_最大化按钮}
SCM_RESTORE = -3; {标题栏_还原按钮}
SCM_CLOSE = -4; {标题栏_关闭按钮}
SCM_MAINMENU = -5; {标题栏_主菜单按钮}
//未公开消息
WM_NCUAHDRAWCAPTION = $00AE;
WM_NCUAHDRAWFRAME = $00AF;
//自定义消息
WM_SkinControl_Click = WM_APP 100; {控件被点击}
WM_SkinControl_SYSClick = WM_APP 101; {控件被点击}
type
SkinControlType = (SCT_NULL, SCT_SYSBUTTON, SCT_MODULEBUTTON);
PSkinControl = ^TSkinControl;
TSkinControl = packed record
SCType: SkinControlType;
CtlID: Integer;
x, y, Width, Height: Integer;
Rect: TRect;
Caption: string;
WCaption: WideString;
wstrLength: Integer;
Image: TGPImage;
bImage: Boolean;
bHover, bPressed, bDisable, bCheck: Boolean;
end;
SkinControlArray = array of TSkinControl;
TSkinForm = class(TForm)
public
//设置窗口背景颜色
procedure SetBkColor(bkColor: Tcolor; bReDraw: Boolean = True);
overload;
procedure SetBkColor(r, g, b: Byte; bReDraw: Boolean = True); overload;
//设置窗口背景图片
procedure SetBkImage(ResName, ResType: string; NineX, NineY, NineWidth,
NineHeight: Integer);
//重绘整个窗口
procedure ReDrawWindow();
//添加模块按钮 (控件ID,按钮标题,资源图片名称,资源类型)
procedure AddModuleButton(CtlID: Integer; Caption, ResName, ResType:
string);
//选中某个模块
procedure SetModuleCheck(CtlID: Integer);
private
{ Private declarations }
procedure WMCreate(var Message: TWMCreate); message WM_CREATE;
procedure WMNCCalcSize(var Message: TWMNCCalcSize); message
WM_NCCALCSIZE;
procedure WMMouseMove(var Message: TWMMouse); message WM_MOUSEMOVE;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMLButtonDown(var Message: TWMMouse); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TWMMouse); message WM_LBUTTONUP;
procedure WMControlClick(var msg: TMessage); message
WM_SkinControl_SYSClick;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
procedure WMNCActivate(var Message: TWMNCActivate); message
WM_NCACTIVATE;
procedure WMNCUAHDrawCaption(var msg: TMessage); message
WM_NCUAHDRAWCAPTION;
procedure WMNCUAHDrawFrame(var msg: TMessage); message
WM_NCUAHDRAWFRAME;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message
WM_ERASEBKGND;
{
procedure WMCtlColor(var Message: TWMCtlColor); message WM_CTLCOLOR;
procedure WMCtlColorBtn(var Message: TWMCtlColorBtn); message
WM_CTLCOLORBTN;
procedure WMCtlColorDlg(var Message: TWMCtlColorDlg); message
WM_CTLCOLORDLG;
procedure WMCtlColorEdit(var Message: TWMCtlColorEdit); message
WM_CTLCOLOREDIT;
procedure WMCtlColorListbox(var Message: TWMCtlColorListbox); message
WM_CTLCOLORLISTBOX;
procedure WMCtlColorMsgbox(var Message: TWMCtlColorMsgbox); message
WM_CTLCOLORMSGBOX;
procedure WMCtlColorScrollbar(var Message: TWMCtlColorScrollbar); message
WM_CTLCOLORSCROLLBAR;
procedure WMCtlColorStatic(var Message: TWMCtlColorStatic); message
WM_CTLCOLORSTATIC; }
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo); message
WM_GETMINMAXINFO;
procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
function CopySkin(hWndDC: HDC): Boolean;
function DrawWindow(): Boolean;
function DrawBackground(): Boolean;
function DrawControls(): Boolean;
function DrawControl(const graphics: TGPGraphics; nIndex: Integer):
Boolean;
procedure DrawControlEx(nIndex: Integer);
function DrawControl_SysBtn(const graphics: TGPGraphics; const Control:
TSkinControl): Boolean;
function DrawControl_Module(const graphics: TGPGraphics; const Control:
TSkinControl): Boolean;
function CreateControl(SCType: SkinControlType; x, y, Width, Height:
Integer; CtlID: Integer = 0): Integer;
procedure MoveControl(nIndex, x, y: Integer; Width: Integer = -1;
Height: Integer = -1);
procedure SetControlImage(nIndex: Integer; ResName, ResType: string);
procedure SetControlText(nIndex: Integer; strText: string);
function GetSysButton(CtlID: Integer): Integer;
procedure SetHoverControl(nIndex: Integer = -1);
procedure SetPressedControl(nIndex: Integer = -1);
function GetHoverIndex(pt: TPoint): Integer;
procedure DisableSysTheme();
procedure DrawNineRect(const graphics: TGPGraphics); overload;
procedure DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; DestRect, SrcRect, NineRect: TRect); overload;
procedure DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; x, y, w, h, srcx, srcy, srcw, srch: Integer); overload;
function CreateRoundPath(x, y, w, h, cornerRadius: Single):
TGPGraphicsPath;
protected
{私有成员变量}
m_hWnd: HWND;
m_hCacheDC, m_hBackDC: HDC;
m_hCacheBitmap, m_hOldCacheBitmap: HBITMAP;
m_hBackBitmap, m_hOldBackBitmap: HBITMAP;
m_nWidth, m_nHeight: integer;
m_bkColor, m_BorderColor1, m_BorderColor2: TGPColor;
m_bkImage: TGPImage;
m_bkNineRect: TGPRect;
m_bkIsImage: Boolean;
m_hIcon: HICON;
m_hFont, m_hBoldFont: HFONT;
m_bIsZoomed: Boolean;
m_ControlArray: SkinControlArray;
m_ControlCount: Integer;
m_ControlSysCount: Integer;
m_HoverIndex, m_PressedIndex: Integer;
m_bTracking: Boolean;
m_ModuleLeft: Integer;
m_ModuleFont: TGPFont;
m_ModuleFormat: TGPStringFormat;
m_ModuleBrush: TGPSolidBrush;
procedure CreateParams(var Params: TCreateParams); override;
public
{ Public declarations }
end;
implementation
procedure TSkinForm.CreateParams(var Params: TCreateParams);
begin
inherited;
Params.Style := Params.Style or WS_CLIPCHILDREN or WS_CLIPSIBLINGS;
//params.Style := params.Style and (not WS_CAPTION);
params.ExStyle := params.ExStyle and (not WS_EX_DLGMODALFRAME);
params.ExStyle := params.ExStyle and (not WS_EX_WINDOWEDGE);
params.ExStyle := params.ExStyle and (not WS_EX_CLIENTEDGE);
Params.WindowClass.Style := CS_VREDRAW or CS_HREDRAW or CS_OWNDC;
//Params.WinClassName := 'CometSkinForm';
end;
procedure TSkinForm.WMCreate(var Message: TWMCreate);
var
buf: array[0..MAX_PATH] of Char;
FileInfo: SHFILEINFO;
lf: TLogFontW;
plf: PLogFontW;
dc: HDC;
begin
m_hWnd := Handle;
m_bkColor := MakeColor(50, 150, 190);
m_bkIsImage := False;
m_BorderColor1 := MakeColor(150, 0, 0, 0);
m_BorderColor2 := MakeColor(150, 255, 255, 255);
m_hFont := GetStockObject(DEFAULT_GUI_FONT);
GetObject(m_hFont, SizeOf(lf), @lf);
lf.lfWeight := FW_BOLD;
m_hBoldFont := CreateFontIndirectW(lf);
m_hIcon := SendMessage(m_hWnd, WM_GETICON, ICON_SMALL, 0);
if m_hIcon = 0 then
begin
GetModuleFileName(0, buf, Length(buf));
SHGetFileInfo(buf, 0, FileInfo, SizeOf(FileInfo), SHGFI_SMALLICON or
SHGFI_ICON);
m_hIcon := FileInfo.hIcon;
end;
//-----------------------
dc := GetDC(0);
plf := @lf;
m_ModuleFont := TGPFont.Create(dc, plf);
ReleaseDC(0, dc);
m_ModuleFormat := TGPStringFormat.Create();
m_ModuleFormat.SetAlignment(StringAlignmentCenter);
m_ModuleFormat.SetLineAlignment(StringAlignmentCenter);
m_ModuleBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255));
//-----------------------
m_bTracking := False;
m_HoverIndex := -1;
m_PressedIndex := -1;
m_ControlCount := 0;
m_ModuleLeft := 7;
CreateControl(SCT_SYSBUTTON, 300, 5, 30, 19, SCM_MAINMENU);
CreateControl(SCT_SYSBUTTON, 300, 5, 30, 19, SCM_MINIMIZE);
CreateControl(SCT_SYSBUTTON, 350, 5, 30, 19, SCM_MAXIMIZE);
CreateControl(SCT_SYSBUTTON, 400, 5, 39, 19, SCM_CLOSE);
m_ControlSysCount := m_ControlCount;
//-----------------------
inherited;
DisableSysTheme();
SetWindowPos(m_hWnd, 0, 0, 0, 0, 0, SWP_FRAMECHANGED or SWP_NOOWNERZORDER or
SWP_NOMOVE or SWP_NOSIZE);
end;
procedure TSkinForm.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
//inherited;
//修改非客户区(标题栏、窗口边框)尺寸
if Message.CalcValidRects then
begin
Message.CalcSize_Params^.rgrc[2] := Message.CalcSize_Params^.rgrc[1];
Message.CalcSize_Params^.rgrc[1] := Message.CalcSize_Params^.rgrc[0];
end
else
begin
end;
Message.Result := 1;
end;
procedure TSkinForm.WMSize(var Message: TWMSize);
begin
if m_hCacheDC <> 0 then
begin
SelectObject(m_hCacheDC, m_hOldCacheBitmap);
SelectObject(m_hBackDC, m_hOldBackBitmap);
DeleteDC(m_hCacheDC);
DeleteDC(m_hBackDC);
DeleteObject(m_hCacheBitmap);
DeleteObject(m_hBackBitmap);
m_hCacheDC := 0;
m_hBackDC := 0;
m_hCacheBitmap := 0;
m_hBackBitmap := 0;
end;
inherited;
end;
procedure TSkinForm.WMGetMinMaxInfo(var msg: TWMGetMinMaxInfo);
var
MyScreen: TScreen;
Monitor: TMonitor;
rc: TRect;
begin
if IsZoomed(m_hWnd) then
begin
MyScreen := TScreen.Create(nil);
Monitor := MyScreen.MonitorFromWindow(m_hWnd);
rc := Monitor.WorkareaRect;
msg.MinMaxInfo.ptMaxPosition.X := rc.Left;
msg.MinMaxInfo.ptMaxPosition.Y := rc.Top;
msg.MinMaxInfo.ptMaxSize.X := rc.right - rc.left;
msg.MinMaxInfo.ptMaxSize.Y := rc.bottom - rc.top;
//SetWindowPos(m_hWnd,0,rc.Left,rc.Top,rc.right-rc.left,rc.bottom-rc.top,SWP_NOZORDER);
msg.Result := 0;
inherited;
end
else
begin
inherited;
end;
end;
procedure TSkinForm.WMActivate(var Message: TWMActivate);
var
rc: TRect;
w, h: integer;
begin
Windows.GetClientRect(m_hWnd, rc);
inherited;
w := rc.Right - rc.Left;
h := rc.Bottom - rc.Top;
//SetWindowPos(m_hWnd,0,0,0,w 1,h 1,SWP_FRAMECHANGED or SWP_NOREDRAW Or SWP_NOOWNERZORDER Or SWP_NOMOVE);
//SetWindowPos(m_hWnd,0,0,0,w,h,SWP_FRAMECHANGED or SWP_DRAWFRAME Or SWP_NOOWNERZORDER Or SWP_NOMOVE);
//InvalidateRect(m_hWnd, nil, False);
end;
procedure TSkinForm.WMMouseMove(var Message: TWMMouse);
var
e: TTrackMouseEvent;
nIndex: Integer;
pt: TPoint;
begin
inherited;
if m_bTracking = False then
begin
m_bTracking := True;
E.cbSize := SIZEof(TTrackMouseEvent);
E.dwFlags := TME_LEAVE;
E.dwHoverTime := 10;
E.hwndTrack := m_hWnd;
trackmouseevent(e);
end;
pt.x := Message.XPos;
pt.y := Message.YPos;
nIndex := GetHoverIndex(pt);
SetHoverControl(nIndex);
end;
procedure TSkinForm.CMMouseLeave(var Message: TMessage);
begin
inherited;
m_bTracking := False;
SetPressedControl(-1);
SetHoverControl(-1);
end;
procedure TSkinForm.WMLButtonDown(var Message: TWMMouse);
var
nIndex: Integer;
pt: TPoint;
begin
inherited;
pt.x := Message.XPos;
pt.y := Message.YPos;
nIndex := GetHoverIndex(pt);
SetPressedControl(nIndex);
if nIndex = -1 then
begin
ReleaseCapture();
PostMessage(m_hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
end;
procedure TSkinForm.WMLButtonUp(var Message: TWMMouse);
var
nIndex, nOldIndex: Integer;
pt: TPoint;
Control: TSkinControl;
begin
inherited;
pt.x := Message.XPos;
pt.y := Message.YPos;
nIndex := GetHoverIndex(pt);
nOldIndex := m_PressedIndex;
SetPressedControl(-1);
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
ReleaseCapture();
Application.ProcessMessages;
Control := m_ControlArray[nIndex];
Windows.PostMessage(m_hWnd, WM_SkinControl_SYSClick, Control.CtlID,
nIndex);
end;
end;
procedure TSkinForm.WMControlClick(var msg: TMessage);
var
nIndex: Integer;
CtlID: Integer;
Control: TSkinControl;
bMsg: Boolean;
begin
nIndex := msg.LParam;
CtlID := msg.WParam;
bMsg := False;
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
Control := m_ControlArray[nIndex];
if Control.SCType = SCT_SYSBUTTON then
begin
if (CtlID = SCM_MAXIMIZE) and IsZoomed(m_hWnd) then
begin
CtlID := SCM_RESTORE;
end;
case CtlID of
SCM_MINIMIZE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_MINIMIZE, 0);
SCM_MAXIMIZE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
SCM_RESTORE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_RESTORE, 0);
SCM_CLOSE:
PostMessage(m_hWnd, WM_SYSCOMMAND, SC_CLOSE, 0);
SCM_MAINMENU:
bMsg := True;
end;
end
else
begin
bMsg := True;
end;
if bMsg then
begin
Windows.PostMessage(m_hWnd, WM_SkinControl_Click, CtlID, nIndex);
end;
end;
end;
procedure TSkinForm.WMPaint(var Message: TWMPaint);
var
ps: PAINTSTRUCT;
dc: HDC;
begin
dc := BeginPaint(handle, ps);
CopySkin(dc);
EndPaint(handle, ps);
Message.Result := 0;
end;
procedure TSkinForm.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
CopySkin(Message.DC);
Message.Result := 1;
end;
procedure TSkinForm.WMNCPaint(var Message: TWMNCPaint);
var
dc: HDC;
begin
dc := GetWindowDC(m_hWnd);
//CopySkin(dc);
ReleaseDC(m_hWnd, dc);
Message.Result := 0;
end;
procedure TSkinForm.WMNCActivate(var Message: TWMNCActivate);
begin
//在这里不能调用默认的处理因为当窗口是非激活状态时会画出默认的Title
//inherited;
Message.Result := 1;
end;
procedure TSkinForm.WMNCUAHDrawCaption(var msg: TMessage);
begin
//这两条消息是在xp sp2后加的.xp在以前有个bug在某些时候Titlebar会画错.
//在这里不能调用默认处理，直接自绘nc区.;
end;
procedure TSkinForm.WMNCUAHDrawFrame(var msg: TMessage);
begin
//这两条消息是在xp sp2后加的.xp在以前有个bug在某些时候Titlebar会画错.
//在这里不能调用默认处理，直接自绘nc区.;
end;
{
procedure TSkinForm.WMCtlColor(var Message: TWMCtlColor);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorBtn(var Message: TWMCtlColorBtn);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorDlg(var Message: TWMCtlColorDlg);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorEdit(var Message: TWMCtlColorEdit);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorListbox(var Message: TWMCtlColorListbox);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorMsgbox(var Message: TWMCtlColorMsgbox);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorScrollbar(var Message: TWMCtlColorScrollbar);
begin
inherited;
end;
procedure TSkinForm.WMCtlColorStatic(var Message: TWMCtlColorStatic);
var
pt: TPoint;
rtControl: TRect;
begin
if m_hBackDC <> 0 then
begin
inherited;
//pt.X:=0;
//pt.Y:=0;
//MapWindowPoints(Message.ChildWnd,m_hWnd,pt,1);
//Windows.GetClientRect(Message.ChildWnd,rtControl);
//BitBlt(Message.ChildDC, 0, 0,rtControl.Right-rtControl.Left, rtControl.Bottom-rtControl.Top, m_hCacheDC,pt.X, pt.Y, SRCCOPY);
//SetTextColor(Message.ChildDC,$FFFFFF) ;
//Message.Result:=GetStockObject(NULL_BRUSH);
end
else
begin
inherited;
end;
end;
}
function TSkinForm.CopySkin(hWndDC: HDC): Boolean;
begin
if m_hCacheDC = 0 then
begin
DrawWindow();
end;
BitBlt(hWndDC, 0, 0, m_nWidth, m_nHeight, m_hCacheDC, 0, 0, SRCCOPY);
end;
function TSkinForm.DrawWindow(): Boolean;
var
hSrcDC: HDC;
rc: TRect;
nWidth, nHeight: integer;
Rgn: HRGN;
begin
m_bIsZoomed := Windows.IsZoomed(m_hWnd);
Windows.GetClientRect(m_hWnd, rc);
nWidth := rc.Right - rc.Left;
nHeight := rc.Bottom - rc.Top;
m_nWidth := nWidth;
m_nHeight := nHeight;
hSrcDC := GetDC(m_hWnd);
m_hCacheDC := CreateCompatibleDC(hSrcDC);
m_hBackDC := CreateCompatibleDC(hSrcDC);
m_hCacheBitmap := CreateCompatibleBitmap(hSrcDC, nWidth, nHeight);
m_hBackBitmap := CreateCompatibleBitmap(hSrcDC, nWidth, nHeight);
m_hOldCacheBitmap := SelectObject(m_hCacheDC, m_hCacheBitmap);
m_hOldBackBitmap := SelectObject(m_hBackDC, m_hBackBitmap);
//--------------------------------------------
SetBkMode(m_hCacheDC, TRANSPARENT);
SetBkMode(m_hBackDC, TRANSPARENT);
//--------------------------------------------
ReleaseDC(m_hWnd, hSrcDC);
DrawBackground();
DrawControls();
//--------------------------------------------
if m_bIsZoomed then
begin
Rgn := CreateRectRgn(0, 0, m_nWidth, m_nHeight);
end
else
begin
Rgn := CreateRoundRectRgn(0, 0, m_nWidth 1, m_nHeight 1, 4, 4);
end;
SetWindowRgn(m_hWnd, Rgn, False);
DeleteObject(Rgn);
result := True;
end;
function TSkinForm.DrawBackground(): Boolean;
var
g: TGPGraphics;
b: TGPSolidBrush;
Pen1, Pen2: TGPPen;
path1, path2: TGPGraphicsPath;
x, y, w, h, cornerRadius, len: Integer;
buf: array[0..MAX_PATH] of Char;
hOldFont: HFONT;
rc: TRect;
rcF, SrcF: TGPRectF;
w1, w2, w3: Single;
begin
//----------------
g := TGPGraphics.Create(m_hBackDC);
b := TGPSolidBrush.Create(m_bkColor);
g.FillRectangle(b, 0, 0, m_nWidth, m_nHeight);
b.Free;
//----------------
if m_bkIsImage then
begin
w := m_bkImage.GetWidth();
h := m_bkImage.GetHeight();
end
else
begin
w := 0;
h := 0;
end;
if (w > 0) and (h > 0) then
begin
if (m_nWidth <= w) and (m_nHeight <= h) then
begin
rcF := MakeRect(0.0, 0.0, m_nWidth, m_nHeight);
SrcF := MakeRect(w - m_nWidth, 0.0, m_nWidth, m_nHeight);
g.DrawImage(m_bkImage, rcF, SrcF.X, SrcF.Y, SrcF.Width, SrcF.Height,
UnitPixel);
end
else if (m_bkNineRect.Width > 0) and (m_bkNineRect.Height > 0) then
begin
//按九宫图绘制
DrawNineRect(g);
end;
end;
//----------------
Pen1 := TGPPen.Create(m_BorderColor1);
Pen2 := TGPPen.Create(m_BorderColor2);
if m_bIsZoomed then
begin
g.DrawRectangle(Pen1, 0, 0, m_nWidth - 1, m_nHeight - 1);
g.DrawRectangle(Pen2, 1, 1, m_nWidth - 3, m_nHeight - 3);
end
else
begin
x := 0;
Y := 0;
w := m_nWidth - 1;
h := m_nHeight - 1;
cornerRadius := 3;
path1 := TGPGraphicsPath.Create();
path1.AddArc(x, y, cornerRadius * 2, cornerRadius * 2, 180, 90); //左上
path1.AddArc(x w - cornerRadius * 2, y, cornerRadius * 2, cornerRadius
* 2, 270, 90); //右上
path1.AddArc(x w - cornerRadius * 2, y h - cornerRadius * 2,
cornerRadius * 2, cornerRadius * 2, 0, 90); //右下
path1.AddArc(x, y h - cornerRadius * 2, cornerRadius * 2, cornerRadius
* 2, 90, 90); //左下
path1.CloseFigure();
g.DrawPath(Pen1, path1);
path1.Free;
x := 1;
Y := 1;
w := m_nWidth - 3;
h := m_nHeight - 3;
cornerRadius := 3;
path2 := TGPGraphicsPath.Create();
path2.AddArc(x, y, cornerRadius * 2, cornerRadius * 2, 180, 90); //左上
path2.AddArc(x w - cornerRadius * 2, y, cornerRadius * 2, cornerRadius
* 2, 270, 90); //右上
path2.AddArc(x w - cornerRadius * 2, y h - cornerRadius * 2,
cornerRadius * 2, cornerRadius * 2, 0, 90); //右下
path2.AddArc(x, y h - cornerRadius * 2, cornerRadius * 2, cornerRadius
* 2, 90, 90); //左下
path2.CloseFigure();
g.DrawPath(Pen2, path2);
path2.Free;
end;
Pen1.Free;
Pen2.Free;
//----------------
//绘制图标
x := 5;
y := 5;
w := 16;
h := 16;
if m_hIcon <> 0 then
begin
DrawIconEx(m_hBackDC, x, y, m_hIcon, w, h, 0, 0, DI_NORMAL);
x := x 20;
end;
//----------------
//绘制标题
rc.Left := x;
rc.Top := y;
rc.Right := m_nWidth - 100;
rc.Bottom := y h;
GetWindowText(m_hWnd, buf, MAX_PATH);
hOldFont := SelectObject(m_hBackDC, m_hBoldFont);
SetTextColor(m_hBackDC, $333333);
DrawText(m_hBackDC, buf, -1, rc, DT_SINGLELINE or DT_VCENTER);
OffsetRect(rc, -1, -1);
SetTextColor(m_hBackDC, $FFFFFF);
DrawText(m_hBackDC, buf, -1, rc, DT_SINGLELINE or DT_VCENTER);
SelectObject(m_hBackDC, hOldFont);
//----------------
g.Free;
result := True;
end;
function TSkinForm.DrawControls(): Boolean;
var
i, x, y, nIndex: Integer;
g: TGPGraphics;
begin
BitBlt(m_hCacheDC, 0, 0, m_nWidth, m_nHeight, m_hBackDC, 0, 0, SRCCOPY);
g := TGPGraphics.Create(m_hCacheDC);
//g.SetSmoothingMode(SmoothingModeAntiAlias);
g.SetInterpolationMode(InterpolationModeHighQualityBicubic);
//----------------
x := m_nWidth - 2;
y := 2;
nIndex := GetSysButton(SCM_CLOSE);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
nIndex := GetSysButton(SCM_MAXIMIZE);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
nIndex := GetSysButton(SCM_MINIMIZE);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
nIndex := GetSysButton(SCM_MAINMENU);
if nIndex > -1 then
begin
x := x - m_ControlArray[nIndex].Width;
MoveControl(nIndex, x, y);
end;
//----------------
for i := 0 to m_ControlCount - 1 do
begin
DrawControl(g, i);
end;
//----------------
g.Free;
result := True;
end;
function TSkinForm.DrawControl(const graphics: TGPGraphics; nIndex: Integer):
Boolean;
var
Control: TSkinControl;
begin
Control := m_ControlArray[nIndex];
case Control.SCType of
SCT_SYSBUTTON:
DrawControl_SysBtn(graphics, Control);
SCT_MODULEBUTTON:
DrawControl_Module(graphics, Control);
end;
result := True;
end;
//画出顶部模块按钮
function TSkinForm.DrawControl_Module(const graphics: TGPGraphics; const
Control: TSkinControl): Boolean;
var
x, y, w, h: Single;
cornerRadius: Integer;
rc: TGPRectF;
c1, c2, c3, c4: TGPColor;
Pen1, Pen2, Pen3: TGPPen;
Brush: TGPSolidBrush;
path1, path2, path3: TGPGraphicsPath;
SmoothingMode: TSmoothingMode;
begin
//画出背景 ========================
if Control.bCheck or Control.bPressed or Control.bHover then
begin
if Control.bCheck or Control.bPressed = True then
begin
c1 := MakeColor(20, 0, 0, 0);
c2 := MakeColor(60, 0, 0, 0);
c3 := MakeColor(120, 255, 255, 255);
c4 := MakeColor(70, 255, 255, 255);
end
else
begin
c1 := MakeColor(15, 0, 0, 0);
c2 := MakeColor(40, 0, 0, 0);
c3 := MakeColor(90, 255, 255, 255);
c4 := MakeColor(50, 255, 255, 255);
end;
Pen1 := TGPPen.Create(c1);
Pen2 := TGPPen.Create(c2);
Pen3 := TGPPen.Create(c3);
Brush := TGPSolidBrush.Create(c4);
x := Control.x;
y := Control.y;
w := Control.Width - 2;
h := Control.Height - 2;
path1 := CreateRoundPath(x, y, w, h, 5);
path2 := CreateRoundPath(x 1, y 1, w - 2, h - 2, 5);
path3 := CreateRoundPath(x 2, y 2, w - 4, h - 4, 5);
SmoothingMode := graphics.GetSmoothingMode();
graphics.SetSmoothingMode(SmoothingModeAntiAlias);
graphics.DrawPath(Pen1, path1);
graphics.DrawPath(Pen2, path2);
graphics.FillPath(Brush, path3);
graphics.DrawPath(Pen3, path3);
graphics.SetSmoothingMode(SmoothingMode);
Pen1.Free;
Pen2.Free;
Pen3.Free;
Brush.Free;
path1.Free;
path2.Free;
path3.Free;
end;
//画出图标 ========================
if Control.bImage then
begin
w := Control.Image.GetWidth();
h := Control.Image.GetHeight();
rc.Width := w;
rc.Height := h;
if rc.Width > 48 then
rc.Width := 48;
if rc.Height > 48 then
rc.Height := 48;
rc.X := Control.x (Control.Width - rc.Width) / 2;
rc.y := Control.y (Control.Height - rc.Height - 20) / 2;
graphics.DrawImage(Control.Image, rc, 0, 0, w, h, UnitPixel);
end;
//画出文字 ========================
if Control.wstrLength > 0 then
begin
Brush := TGPSolidBrush.Create(MakeColor(60, 0, 0, 0));
rc := MakeRect(Control.x 1, Control.y 1 Control.Height - 20,
Control.Width - 1, 18.0);
graphics.DrawString(Control.WCaption, -1, m_ModuleFont, rc,
m_ModuleFormat, Brush);
rc.x := rc.x - 1;
rc.y := rc.y - 1;
graphics.DrawString(Control.WCaption, -1, m_ModuleFont, rc,
m_ModuleFormat, m_ModuleBrush);
Brush.Free;
end;
//--------------------------
result := True;
end;
//画出系统按钮(最小化、最大化...)
function TSkinForm.DrawControl_SysBtn(const graphics: TGPGraphics; const
Control: TSkinControl): Boolean;
var
path1, IconPath, IconPath2: TGPGraphicsPath;
IconBrush: TGPSolidBrush;
IconPen: TGPPen;
LineBrush1, LineBrush2: TGPLinearGradientBrush;
x, y, w, h: Single;
i, CtlID: Integer;
rc: TGPRectF;
c1, c2: TGPColor;
begin
CtlID := Control.CtlID;
if (CtlID = SCM_MAXIMIZE) and m_bIsZoomed then
begin
CtlID := SCM_RESTORE;
end;
//画出背景 ========================
if Control.bPressed or Control.bHover then
begin
x := Control.x 1;
y := Control.y;
w := Control.Width - 1;
h := Control.Height;
if Control.CtlID = SCM_CLOSE then
begin
if Control.bPressed = True then
begin
c1 := MakeColor(180, 128, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
end
else
begin
c1 := MakeColor(180, 255, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
end;
end
else
begin
w := w - 2;
if Control.bPressed = True then
begin
c1 := MakeColor(90, 0, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
end
else
begin
c1 := MakeColor(60, 255, 255, 255);
c2 := MakeColor(0, 255, 255, 255);
end;
end;
rc := MakeRect(x, y, 1, h);
LineBrush1 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
rc := MakeRect(x, y, w, h);
graphics.FillRectangle(LineBrush1, rc);
rc.X := rc.X - 1;
LineBrush2 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
graphics.FillRectangle(LineBrush2, rc);
LineBrush1.Free();
LineBrush2.Free();
end;
//画出图标 ========================
w := 11;
h := 9;
x := Control.x ((Control.Width - w) / 2) - 1;
y := Control.y ((Control.Height - h) / 2) - 1;
IconPath := TGPGraphicsPath.Create();
IconPath.SetFillMode(FillModeWinding);
case CtlID of
SCM_MINIMIZE:
begin
rc.x := integer(Trunc(x));
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 2;
rc.Width := integer(Trunc(w));
rc.Height := 2;
IconPath.AddRectangle(rc);
end;
SCM_MAXIMIZE:
begin
h := 8;
y := y 1;
rc.x := integer(Trunc(x));
rc.Y := integer(Trunc(y));
rc.Width := integer(Trunc(w));
rc.Height := 2;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 1;
rc.Height := 1;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y));
rc.Width := 1;
rc.Height := integer(Trunc(h));
IconPath.AddRectangle(rc);
rc.x := integer(Trunc(x)) integer(Trunc(w)) - 1;
IconPath.AddRectangle(rc);
end;
SCM_RESTORE:
begin
w := 12;
h := 8;
y := y 1;
x := x - 1;
rc := MakeRect(x 2, y 0.0, 10, 1);
IconPath.AddRectangle(rc);
rc := MakeRect(x 2, y 0.0, 1, 2);
IconPath.AddRectangle(rc);
rc := MakeRect(x 11, y 0.0, 1, 6);
IconPath.AddRectangle(rc);
rc := MakeRect(x 9, y 6, 3, 1);
IconPath.AddRectangle(rc);
rc := MakeRect(x, y 2, 10, 2);
IconPath.AddRectangle(rc);
rc := MakeRect(x, y 2, 1, 6);
IconPath.AddRectangle(rc);
rc := MakeRect(x 9, y 2, 1, 6);
IconPath.AddRectangle(rc);
rc := MakeRect(x, y 7, 10, 1);
IconPath.AddRectangle(rc);
end;
SCM_CLOSE:
begin
for i := 0 to 8 do
begin
rc.x := integer(Trunc(x)) i;
rc.Y := integer(Trunc(y)) i;
rc.Width := 3;
rc.Height := 1;
IconPath.AddRectangle(rc);
rc.x := integer(Trunc(x)) integer(Trunc(w)) - i - 3;
IconPath.AddRectangle(rc);
end;
end;
SCM_MAINMENU:
begin
rc.x := integer(Trunc(x));
rc.Y := integer(Trunc(y));
rc.Width := integer(Trunc(w));
rc.Height := 2;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 1;
rc.Height := 1;
IconPath.AddRectangle(rc);
rc.Y := integer(Trunc(y));
rc.Width := 1;
rc.Height := integer(Trunc(h));
IconPath.AddRectangle(rc);
rc.x := integer(Trunc(x)) integer(Trunc(w)) - 1;
IconPath.AddRectangle(rc);
rc.Width := 1;
rc.Height := 1;
rc.Y := integer(Trunc(y)) integer(Trunc(h)) - 3;
rc.X := integer(Trunc(x)) ((w - rc.Width) / 2);
IconPath.AddRectangle(rc);
rc.Width := 3;
rc.Y := rc.Y - rc.Height;
rc.X := integer(Trunc(x)) ((w - rc.Width) / 2);
IconPath.AddRectangle(rc);
rc.Width := 5;
rc.Y := rc.Y - rc.Height;
rc.X := integer(Trunc(x)) ((w - rc.Width) / 2);
IconPath.AddRectangle(rc);
end;
end;
IconPath.CloseAllFigures();
IconPath2 := TGPGraphicsPath.Create(IconPath);
IconBrush := TGPSolidBrush.Create(MakeColor(255, 255, 255));
IconPen := TGPPen.Create(MakeColor(50, 0, 0, 0));
IconPath.Widen(IconPen);
graphics.DrawPath(IconPen, IconPath);
IconPath.Widen(IconPen);
graphics.DrawPath(IconPen, IconPath);
graphics.FillPath(IconBrush, IconPath2);
IconPath.Free;
IconPath2.Free;
IconPen.Free;
IconBrush.Free;
//画出分割线 ========================
if Control.CtlID <> SCM_CLOSE then
begin
x := Control.x Control.Width - 1;
y := Control.y;
rc := MakeRect(x, y, 1, Control.Height);
c1 := MakeColor(120, 255, 255, 255);
c2 := MakeColor(0, 255, 255, 255);
LineBrush1 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
graphics.FillRectangle(LineBrush1, rc);
rc.X := rc.X - 1;
c1 := MakeColor(90, 0, 0, 0);
c2 := MakeColor(0, 0, 0, 0);
LineBrush2 := TGPLinearGradientBrush.Create(rc, c1, c2,
LinearGradientModeVertical);
graphics.FillRectangle(LineBrush2, rc);
LineBrush1.Free();
LineBrush2.Free();
end;
//--------------------------
result := True;
end;
function TSkinForm.CreateControl(SCType: SkinControlType; x, y, Width, Height:
Integer; CtlID: Integer = 0): Integer;
var
nIndex: Integer;
begin
SetLength(m_ControlArray, m_ControlCount 1);
nIndex := m_ControlCount;
m_ControlCount := Length(m_ControlArray);
m_ControlArray[nIndex].SCType := SCType;
m_ControlArray[nIndex].CtlID := CtlID;
m_ControlArray[nIndex].bHover := False;
m_ControlArray[nIndex].bPressed := False;
m_ControlArray[nIndex].bDisable := False;
m_ControlArray[nIndex].bCheck := False;
m_ControlArray[nIndex].bImage := False;
MoveControl(nIndex, x, y, Width, Height);
result := nIndex;
end;
procedure TSkinForm.MoveControl(nIndex, x, y: Integer; Width: Integer = -1;
Height: Integer = -1);
begin
m_ControlArray[nIndex].x := x;
m_ControlArray[nIndex].y := y;
if Width > -1 then
m_ControlArray[nIndex].Width := Width;
if Height > -1 then
m_ControlArray[nIndex].Height := Height;
m_ControlArray[nIndex].Rect.Left := x;
m_ControlArray[nIndex].Rect.Top := y;
m_ControlArray[nIndex].Rect.Right := x m_ControlArray[nIndex].Width;
m_ControlArray[nIndex].Rect.Bottom := y m_ControlArray[nIndex].Height;
end;
function TSkinForm.GetSysButton(CtlID: Integer): Integer;
var
nIndex, i: Integer;
begin
nIndex := -1;
for i := 0 to m_ControlSysCount - 1 do
begin
if m_ControlArray[i].CtlID = CtlID then
begin
nIndex := i;
break;
end;
end;
result := nIndex;
end;
procedure TSkinForm.SetBkColor(bkColor: Tcolor; bReDraw: Boolean = True);
begin
m_bkColor := ColorRefToARGB(bkColor);
if bReDraw then
ReDrawWindow();
end;
procedure TSkinForm.SetBkColor(r, g, b: Byte; bReDraw: Boolean = True);
begin
m_bkColor := MakeColor(r, g, b);
if bReDraw then
ReDrawWindow();
end;
//设置窗口背景图片
procedure TSkinForm.SetBkImage(ResName, ResType: string; NineX, NineY,
NineWidth, NineHeight: Integer);
var
hMod: HMODULE;
HRes: HRSRC;
sResName: string;
sResType: string;
Len: DWORD;
lpRsrc: PByte;
m_hMem: HGLOBAL;
pMem: PByte;
pstm: IStream;
begin
m_bkNineRect := MakeRect(NineX, NineY, NineWidth, NineHeight);
if m_bkIsImage then
begin
m_bkImage.destroy();
m_bkImage.Free();
m_bkIsImage := False;
end;
hMod := GetModuleHandle(nil);
sResName := ResName;
sResType := ResType;
HRes := FindResource(HInstance, PChar(sResName), PChar(sResType));
if HRes <> 0 then
begin
Len := SizeofResource(HInstance, HRes);
lpRsrc := PByte(LoadResource(HInstance, HRes));
try
if lpRsrc <> nil then
begin
m_hMem := GlobalAlloc(GMEM_FIXED, Len);
pMem := Pbyte(GlobalLock(m_hMem));
CopyMemory(pMem, lpRsrc, Len);
CreateStreamOnHGlobal(m_hMem, False, pstm);
m_bkImage := TGPImage.Create(pstm);
m_bkIsImage := True;
GlobalUnlock(m_hMem);
pstm := nil;
FreeResource(Dword(lpRsrc));
end;
except
end;
end;
ReDrawWindow();
end;
procedure TSkinForm.ReDrawWindow();
begin
if (IsWindowVisible(m_hWnd)) and (IsIconic(m_hWnd) = False) then
begin
DrawWindow();
InvalidateRect(m_hWnd, nil, False);
end;
end;
procedure TSkinForm.DrawControlEx(nIndex: Integer);
var
Control: TSkinControl;
g: TGPGraphics;
dc: HDC;
begin
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
Control := m_ControlArray[nIndex];
BitBlt(m_hCacheDC, Control.x, Control.y, Control.Width, Control.Height,
m_hBackDC, Control.x, Control.y, SRCCOPY);
g := TGPGraphics.Create(m_hCacheDC);
g.SetInterpolationMode(InterpolationModeHighQualityBicubic);
//--------------
DrawControl(g, nIndex);
//--------------
dc := GetDC(m_hWnd);
BitBlt(dc, Control.x, Control.y, Control.Width, Control.Height,
m_hCacheDC, Control.x, Control.y, SRCCOPY);
ReleaseDC(m_hWnd, dc);
end;
end;
procedure TSkinForm.SetHoverControl(nIndex: Integer = -1);
var
nOldIndex: Integer;
begin
if m_HoverIndex <> nIndex then
begin
nOldIndex := m_HoverIndex;
m_HoverIndex := nIndex;
if (nOldIndex > -1) and (nOldIndex < m_ControlCount) then
begin
m_ControlArray[nOldIndex].bHover := False;
DrawControlEx(nOldIndex);
end;
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
m_ControlArray[nIndex].bHover := True;
DrawControlEx(nIndex);
end;
end;
end;
procedure TSkinForm.SetPressedControl(nIndex: Integer = -1);
var
nOldIndex: Integer;
begin
if m_PressedIndex <> nIndex then
begin
nOldIndex := m_PressedIndex;
m_PressedIndex := nIndex;
if (nOldIndex >= 0) and (nOldIndex < m_ControlCount) then
begin
m_ControlArray[nOldIndex].bPressed := False;
DrawControlEx(nOldIndex);
end;
if (nIndex >= 0) and (nIndex < m_ControlCount) then
begin
m_ControlArray[nIndex].bPressed := True;
DrawControlEx(nIndex);
end;
end;
end;
function TSkinForm.GetHoverIndex(pt: TPoint): Integer;
var
nIndex, i: Integer;
begin
nIndex := -1;
for i := 0 to m_ControlCount - 1 do
begin
if PtInRect(m_ControlArray[i].Rect, pt) then
begin
nIndex := i;
break;
end;
end;
result := nIndex;
end;
procedure TSkinForm.DisableSysTheme();
var
Module: HMODULE;
dwAttr: DWORD;
lpSetWindowTheme: function(hWnd: HWND; a, b: Integer): Integer; StdCall;
lpDwmSetWindowAttribute: function(hWnd: HWND; dwAttribute: DWORD;
pvAttribute: LPDWORD; cbAttribute: DWORD): Integer; StdCall;
begin
//防止xp 、vista、win7 用主题绘制窗口nc区
//vista、win7厚边框问题解决办法
Module := GetModuleHandle('UxTheme.dll');
if Module = 0 then
Module := LoadLibrary('UxTheme.dll');
if Module <> 0 then
begin
@lpSetWindowTheme := GetProcAddress(Module, 'SetWindowTheme');
lpSetWindowTheme(m_hWnd, 0, 0);
end;
Module := GetModuleHandle('dwmapi.dll');
if Module = 0 then
Module := LoadLibrary('dwmapi.dll');
if Module <> 0 then
begin
dwAttr := 1;
@lpDwmSetWindowAttribute := GetProcAddress(Module,
'DwmSetWindowAttribute');
lpDwmSetWindowAttribute(m_hWnd, 2, @dwAttr, 4);
end;
end;
procedure TSkinForm.DrawNineRect(const graphics: TGPGraphics);
var
DestRect, SrcRect, NineRect: TRect;
begin
DestRect.Left := 0;
DestRect.Top := 0;
DestRect.Right := m_nWidth;
DestRect.Bottom := m_nHeight;
SrcRect.Left := 0;
SrcRect.Top := 0;
SrcRect.Right := m_bkImage.GetWidth();
SrcRect.Bottom := m_bkImage.GetHeight();
NineRect.Left := m_bkNineRect.X;
NineRect.Top := m_bkNineRect.Y;
NineRect.Right := m_bkNineRect.X m_bkNineRect.Width;
NineRect.Bottom := m_bkNineRect.y m_bkNineRect.Height;
DrawNineRect(graphics, m_bkImage, DestRect, SrcRect, NineRect);
end;
procedure TSkinForm.DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; DestRect, SrcRect, NineRect: TRect);
var
x, y, nWidth, nHeight: Integer;
xSrc, ySrc, nSrcWidth, nSrcHeight: Integer;
nDestWidth, nDestHeight: Integer;
begin
//g.DrawImage(m_bkImage,rcF,SrcF.X,SrcF.Y,SrcF.Width,SrcF.Height,UnitPixel);
nDestWidth := DestRect.right - DestRect.left;
nDestHeight := DestRect.bottom - DestRect.top;
nDestWidth := DestRect.right - DestRect.left;
nDestHeight := DestRect.bottom - DestRect.top;
// 左上-------------------------------------;
x := DestRect.left;
y := DestRect.top;
nWidth := NineRect.left - SrcRect.left;
nHeight := NineRect.top - SrcRect.top;
xSrc := SrcRect.left;
ySrc := SrcRect.top;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
// 上-------------------------------------;
x := DestRect.left NineRect.left - SrcRect.left;
nWidth := nDestWidth - nWidth - (SrcRect.right - NineRect.right);
xSrc := NineRect.left;
nSrcWidth := NineRect.right - NineRect.left;
nSrcHeight := NineRect.top - SrcRect.top;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 右上-------------------------------------;
x := DestRect.right - (SrcRect.right - NineRect.right);
nWidth := SrcRect.right - NineRect.right;
xSrc := NineRect.right;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
// 左-------------------------------------;
x := DestRect.left;
y := DestRect.top NineRect.top - SrcRect.top;
nWidth := NineRect.left - SrcRect.left;
nHeight := DestRect.top nDestHeight - y - (SrcRect.bottom -
NineRect.bottom);
xSrc := SrcRect.left;
ySrc := NineRect.top;
nSrcWidth := NineRect.left - SrcRect.left;
nSrcHeight := NineRect.bottom - NineRect.top;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 中-------------------------------------;
x := DestRect.left NineRect.left - SrcRect.left;
nWidth := nDestWidth - nWidth - (SrcRect.right - NineRect.right);
xSrc := NineRect.left;
nSrcWidth := NineRect.right - NineRect.left;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 右-------------------------------------;
x := DestRect.right - (SrcRect.right - NineRect.right);
nWidth := SrcRect.right - NineRect.right;
xSrc := NineRect.right;
nSrcWidth := SrcRect.right - NineRect.right;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 左下-------------------------------------;
x := DestRect.left;
y := DestRect.top nDestHeight - (SrcRect.bottom - NineRect.bottom);
nWidth := NineRect.left - SrcRect.left;
nHeight := SrcRect.bottom - NineRect.bottom;
xSrc := SrcRect.left;
ySrc := NineRect.bottom;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
// 下-------------------------------------;
x := DestRect.left NineRect.left - SrcRect.left;
nWidth := nDestWidth - nWidth - (SrcRect.right - NineRect.right);
xSrc := NineRect.left;
nSrcWidth := NineRect.right - NineRect.left;
nSrcHeight := SrcRect.bottom - NineRect.bottom;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nSrcWidth,
nSrcHeight);
// 右下-------------------------------------;
x := DestRect.right - (SrcRect.right - NineRect.right);
nWidth := SrcRect.right - NineRect.right;
xSrc := NineRect.right;
DrawNineRect(graphics, image, x, y, nWidth, nHeight, xSrc, ySrc, nWidth,
nHeight);
end;
procedure TSkinForm.DrawNineRect(const graphics: TGPGraphics; const image:
TGPImage; x, y, w, h, srcx, srcy, srcw, srch: Integer);
var
RcF, SrcF: TGPRectF;
begin
RcF.X := x;
RcF.Y := y;
RcF.Width := w;
RcF.Height := h;
SrcF.X := Srcx;
SrcF.Y := Srcy;
SrcF.Width := Srcw;
SrcF.Height := Srch;
graphics.DrawImage(image, rcF, SrcF.X, SrcF.Y, SrcF.Width, SrcF.Height,
UnitPixel);
end;
procedure TSkinForm.AddModuleButton(CtlID: Integer; Caption, ResName, ResType:
string);
var
nIndex: Integer;
begin
nIndex := CreateControl(SCT_MODULEBUTTON, m_ModuleLeft, 24, 72, 76, CtlID);
m_ModuleLeft := m_ModuleLeft m_ControlArray[nIndex].Width 5;
SetControlText(nIndex, Caption);
SetControlImage(nIndex, ResName, ResType);
end;
procedure TSkinForm.SetModuleCheck(CtlID: Integer);
var
i: Integer;
begin
for i := 0 to m_ControlCount - 1 do
begin
if m_ControlArray[i].SCType = SCT_MODULEBUTTON then
begin
if m_ControlArray[i].CtlID = CtlID then
begin
m_ControlArray[i].bCheck := True;
DrawControlEx(i);
end
else if m_ControlArray[i].bCheck then
begin
m_ControlArray[i].bCheck := False;
DrawControlEx(i);
end;
end;
end;
end;
procedure TSkinForm.SetControlText(nIndex: Integer; strText: string);
var
nLen: integer;
begin
if (nIndex < 0) or (nIndex >= m_ControlCount) then
exit;
m_ControlArray[nIndex].Caption := strText;
//----------------------
if strText = '' then
begin
m_ControlArray[nIndex].WCaption := '';
m_ControlArray[nIndex].wstrLength := 0;
end
else
begin
m_ControlArray[nIndex].WCaption := strText;
m_ControlArray[nIndex].wstrLength := Length(strText);
{nLen := MultiByteToWideChar(936, 1, PChar(@strText[1]), -1, nil, 0);
SetLength(m_ControlArray[nIndex].WCaption, nLen - 1);
if nLen > 1 then
MultiByteToWideChar(936, 1, PChar(@strText[1]), -1,
PWideChar(@m_ControlArray[nIndex].WCaption[1]), nLen - 1);
m_ControlArray[nIndex].wstrLength := nLen;}
end;
end;
procedure TSkinForm.SetControlImage(nIndex: Integer; ResName, ResType: string);
var
hMod: HMODULE;
HRes: HRSRC;
sResName: string;
sResType: string;
Len: DWORD;
lpRsrc: PByte;
m_hMem: HGLOBAL;
pMem: PByte;
pstm: IStream;
begin
if (nIndex < 0) or (nIndex >= m_ControlCount) then
exit;
if m_ControlArray[nIndex].bImage then
begin
m_ControlArray[nIndex].Image.destroy();
m_ControlArray[nIndex].Image.Free();
m_ControlArray[nIndex].bImage := False;
end;
hMod := GetModuleHandle(nil);
sResName := ResName;
sResType := ResType;
HRes := FindResource(HInstance, PChar(sResName), PChar(sResType));
if HRes <> 0 then
begin
Len := SizeofResource(HInstance, HRes);
lpRsrc := PByte(LoadResource(HInstance, HRes));
try
if lpRsrc <> nil then
begin
m_hMem := GlobalAlloc(GMEM_FIXED, Len);
pMem := Pbyte(GlobalLock(m_hMem));
CopyMemory(pMem, lpRsrc, Len);
CreateStreamOnHGlobal(m_hMem, False, pstm);
m_ControlArray[nIndex].Image := TGPImage.Create(pstm);
m_ControlArray[nIndex].bImage := True;
GlobalUnlock(m_hMem);
pstm := nil;
FreeResource(Dword(lpRsrc));
end;
except
end;
end;
end;
function TSkinForm.CreateRoundPath(x, y, w, h, cornerRadius: Single):
TGPGraphicsPath;
var
path1: TGPGraphicsPath;
begin
path1 := TGPGraphicsPath.Create();
path1.AddArc(x, y, cornerRadius * 2, cornerRadius * 2, 180, 90); //左上
path1.AddArc(x w - cornerRadius * 2, y, cornerRadius * 2, cornerRadius
* 2, 270, 90); //右上
path1.AddArc(x w - cornerRadius * 2, y h - cornerRadius * 2,
cornerRadius * 2, cornerRadius * 2, 0, 90); //右下
path1.AddArc(x, y h - cornerRadius * 2, cornerRadius * 2, cornerRadius
* 2, 90, 90); //左下
path1.CloseFigure();
result := path1;
end;
end.
评论